home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / dirs.swg / 0034_Create Directories.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-25  |  2.8 KB  |  81 lines
  1. (*
  2. RF>   Has anyone written a function for creating a pathname ?
  3. RF>   I'm having a problem with putting together a function that you
  4. RF>   can pass a pathname to, such as: C:\WINDOWS\SYSTEM\STUFF
  5. RF>   and have it create the path if it's at all possible.
  6.  
  7. Try the following, taken from a couple (one DOS, one Windows) of
  8. install programs I am working on.  Lines beginning {} should
  9. be replaced with your preferred error reporting methods (they
  10. currently use my UNIXGUI package).  This is not guaranteed to
  11. trap all possible errors.
  12.  
  13. LEGALDIR will return true if the path is legal.  You *must* specify
  14. the drive in the path as in C:\WINDOWS\SYSTEM\STUFF
  15. *)
  16. Function LegalDir(path:string):boolean;
  17.     var flag:boolean;
  18.     begin
  19.          path:=short(path);
  20.          flag:=true;
  21.          if path[1]<'A' then flag:=false;
  22.          if path[1]>'Z' then flag:=false;
  23.          if path[2]<>':' then flag:=false;
  24.          if path[3]<>'\' then flag:=false;
  25.          delete(path,1,3);
  26.          While path<>'' do
  27.          begin
  28.               if pos('\',path)>9 then flag:=false;
  29.               if ((length(path)>1) and (path[1]='\') and (path[2]='\'))
  30.                  then flag:=false;
  31.               if path[1]=' ' then flag:=false;
  32.               if  not (path[1] in
  33.                  ['A','B','C','D','E','F','G','H','I','J','K','L','M',
  34.                   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  35.                   '1','2','3','4','5','6','7','8','9','0','_','^','$',
  36.                   '~','!','#','%','&','-','{','}','(',')','\'])
  37.                  then flag:=false;
  38.  
  39.               delete(path,1,1);
  40.          end;
  41.          if not flag then
  42.          begin
  43. {}             WinOkDialogue('Cannot Install',
  44.                              'Illegal Directory name!',
  45.                              'Please re-edit and',
  46.                              'try again.');
  47.          end;
  48.          LegalDir:=flag;
  49.     end;
  50. {
  51. MAKEDIRECTORY will make the directory structure you pass to it.  Best
  52. to call LEGALDIR first, for obvious reasons.
  53. }
  54.     Procedure MakeDirectory(st:string);
  55.     var ns:string;
  56.         ior:word;
  57.     begin
  58.         Chdir(st);
  59.         if ioresult=0 then exit;
  60.         MKDIR(st);
  61.         ior:=ioresult;
  62.         if ior=3 then
  63.         begin
  64.             ns:=st;
  65.             while ns[length(ns)]<>'\' do delete(ns,length(ns),1);
  66.             delete(ns,length(ns),1);
  67.             MakeDirectory(ns);
  68.             MakeDirectory(st);
  69.         end;
  70.         if ((ior<>0) and (ior<>3)) then
  71.         begin
  72. {}             Popdialogue;
  73. {}             WinOkDialogue('Error',
  74.                              'Illegal Directory',
  75.                              'or drive error!',
  76.                              'Halting...');
  77. {}             closegui;
  78.              halt;
  79.         end;
  80.     end;
  81.